      SUBROUTINE SETUP
      RETURN
      END
C
C   HS67
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      DOUBLE PRECISION X(NX),Y(8),GY(3,8),FX
      ICF=ICF+1
      CALL YGY(X,Y,GY)
      FX=-.063D0*Y(2)*Y(5)+5.04D0*X(1)+3.36D0*Y(3)+.035D0*X(2)
     F   +10.D0*X(3)
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      INTEGER J
      DOUBLE PRECISION X(NX),GRADF(NX),Y(8),GY(3,8),A(3)
      SAVE A
      DATA A/5.04D0,.035D0,1.D1/
      ICGF=ICGF+1
      CALL YGY(X,Y,GY)
      DO J=1,3
      GRADF(J)=A(J)+3.36D0*GY(J,3)-.063D0*(Y(2)*GY(J,5)+GY(J,2)*Y(5))
      ENDDO
      RETURN
      END
      SUBROUTINE EH(I,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),HXI
      RETURN
      END
      SUBROUTINE EGRADH(I,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADHI(NX)
      RETURN
      END
      SUBROUTINE EG(I,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),Y(8),GY(3,8),UG(3),OG(3),A(14),GXI
      SAVE UG,OG,A
      DATA UG/3*1.D-5/
      DATA OG/2.D3,1.6D4,1.2D2/
      DATA A /2*0.D0,8.5D1,9.0D1,3.D0,1.D-2,1.45D2,5.D3,2.D3,
     F        9.3D1,9.5D1,12.D0,4.D0,1.62D2/
      IF ( GUNIT(1,I+NH) .EQ. -1 )CRES(I+NH)=CRES(I+NH)+1
      IF(I .GT. 14) THEN
        IF ( I .LE. 17 ) THEN
          GXI=X(I-14)-UG(I-14)
        ELSE
          GXI=OG(I-17)-X(I-17)
        ENDIF
      ELSE
        CALL YGY(X,Y,GY)
        IF ( I.LE. 7 ) THEN
          GXI=Y(I+1)-A(I)
        ELSE
          GXI=A(I)-Y(I-6)
        ENDIF
      ENDIF
      RETURN
      END
      SUBROUTINE EGRADG(I,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX),GRADGI(NX),Y(8),GY(3,8)
      IF ( GUNIT(1,I+NH) .EQ. 1 )RETURN
      CGRES(I+NH)=CGRES(I+NH)+1
      CALL YGY(X,Y,GY)
      IF ( I .LE. 7 ) THEN
        DO J=1,3
          GRADGI(J)=GY(J,I+1)
        ENDDO
      ELSE
        DO  J=1,3
          GRADGI(J)=-GY(J,I-6)
        ENDDO
      ENDIF
      RETURN
      END
      SUBROUTINE YGY(X,Y,GY)
      IMPLICIT NONE
      INCLUDE 'PARAM.INC'
      INTEGER ITER,J
      DOUBLE PRECISION X(NX),Y(8),GY(3,8)
      DOUBLE PRECISION X1,X2,X3,C1(3),C2(3),Z2A,Z2,
     F    C,F,G,AL,FAC,Z4,Z4A,T1,T2,T3,HX,BE,T,FB
      X1=X(1)
      X2=X(2)
      X3=X(3)
      Z2A=0.D0
      C=X2/X1-1.D0
      F=1.12D0+C*(.13167D0-C/150.D0)
      G=.1606374D0-C/75.D0*1.22D0
      AL=-2.9768D0/300.D0
      Z2=1.6D0
      ITER=0
      DO WHILE (DABS(Z2-Z2A) .GT. 1.D-8 .AND. ITER .LE. 300)
        ITER=ITER+1
        Z2A=Z2
        Z2=F+(G+AL*Z2)*Z2
      ENDDO
      Y(2)=Z2*X1
      Y(3)=1.22D0*Y(2)-X1
      Y(6)=(X2+Y(3))/X1
      C1(1)=-X2/X1**2
      C1(2)=1.D0/X1
      C1(3)=0.D0
      FAC=(.13167D0-(C+1.22D0*Z2)/75.D0)*X1/(1.D0-G-2.D0*Z2*AL)
      DO J=1,3
        GY(J,2)=FAC*C1(J)
      ENDDO
      GY(1,2)=Z2+GY(1,2)
      DO J=1,3
        GY(J,3)=1.22D0*GY(J,2)
      ENDDO
      GY(1,3)=GY(1,3)-1.D0
      DO J=1,3
        GY(J,6)=C1(J)+GY(J,3)/X1
      ENDDO
      GY(1,6)=GY(1,6)-Y(3)/X1**2
      FAC=1.098D0-.076D0*Y(6)
      DO J=1,3
        C2(J)=FAC*GY(J,6)
      ENDDO
      HX=86.35D0+(1.098D0-0.038D0*Y(6))*Y(6)
      Z4A=0.D0
      Z4=93.D0/X3
      BE=-.21645D-3*Y(2)
      T=1.D0+Y(2)*(84.61005D0-.666D0*HX)/(X3*1000.D0)
      ITER=0
      DO WHILE ( DABS(Z4-Z4A) .GT. 1.D-8 .AND. ITER .LE. 300)
        ITER=ITER+1
        Z4A=Z4
        Z4=98.D0/(T+BE*Z4)/X3
      ENDDO
      ITER=0
      Y(4)=Z4*X3
      Y(5)=HX+.325D0*(Y(4)-89.D0)
      Y(8)=3.D0*Y(5)-133.D0
      Y(7)=35.82D0-.222D0*Y(8)
      FAC=Z4/(T+BE*Z4)
      FB=1.D0/(1.D0+BE*FAC)
      T1=(84.61005D0-.666D0*HX)/X3/1000.D0
      T2=-.666D-3*Y(2)/X3
      T3=-T1*Y(2)/X3
      DO J=1,3
        C1(J)=-(GY(J,2)*T1+C2(J)*T2)*FAC
      ENDDO
      C1(3)=C1(3)-T3*FAC
      DO J=1,3
        C1(J)=C1(J)*X3+FAC*.21645D-3*Y(4)*GY(J,2)
      ENDDO
      C1(3)=C1(3)+FAC*BE*Z4
      DO J=1,3
        GY(J,4)=C1(J)*FB
        GY(J,5)=C2(J)+.325D0*GY(J,4)
        GY(J,8)=3.D0*GY(J,5)
        GY(J,7)=-.222D0*GY(J,8)
      ENDDO
      RETURN
      END
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER I,J
      DATA NAME/'HS67'/
      DATA (X(I),I=1,3)/1745.D0,1.2D4,1.1D2/
      DATA N/ 3/ , NH/0/ , NG/20/
      DATA DEL0/1.0D0/ ,TAU0/1.0D0/ ,TAU/.1D0/
      DATA ((GUNIT(I,J),I=1,3),J=0,20)
     F     /-1,0,0,-1,0,0,-1,0,0,-1,0,0,-1,0,0,
     F     -1,0,0,-1,0,0,-1,0,0,-1,0,0,-1,0,0,
     F     -1,0,0,-1,0,0,-1,0,0,-1,0,0,-1,0,0,
     F      1,1,1, 1,2,1, 1,3,1,
     F     1,1,-1,1,2,-1,1,3,-1/
      END



